home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Grab Bag
/
Shareware Grab Bag.iso
/
001
/
pibt40s1.arc
/
DOSCRIPC.MOD
< prev
next >
Wrap
Text File
|
1987-05-25
|
11KB
|
232 lines
(*----------------------------------------------------------------------*)
(* Do_Script_Checks --- Check Script-related quantities for character *)
(*----------------------------------------------------------------------*)
PROCEDURE Do_Script_Checks( Ch: CHAR );
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Do_Script_Checks *)
(* *)
(* Purpose: Do script-related checks on character received *)
(* from comm port. *)
(* *)
(* Calling Sequence: *)
(* *)
(* Do_Script_Checks( Ch : CHAR ); *)
(* *)
(* Ch --- Character received from Comm. port. *)
(* *)
(* Calls: TimeOfDay *)
(* TimeDiff *)
(* Send_Function_Key *)
(* CompareStr *)
(* Check_Wait_String_Time *)
(* *)
(*----------------------------------------------------------------------*)
VAR
L : INTEGER;
L2 : INTEGER;
I : INTEGER;
LABEL 1;
(*----------------------------------------------------------------------*)
(* CmpS --- Check two equal-length strings for equality *)
(*----------------------------------------------------------------------*)
FUNCTION CmpS( VAR S1; VAR S2; N: INTEGER ) : BOOLEAN;
(*----------------------------------------------------------------------*)
(* *)
(* Here is a (very slow) Pascal version of this routine: *)
(* *)
(* FUNCTION CmpS( VAR S1; VAR S2; N: INTEGER ); *)
(* *)
(* TYPE *)
(* Byte_String = ARRAY[1..255] OF BYTE; *)
(* *)
(* VAR *)
(* BS1 : Byte_String ABSOLUTE S1; *)
(* BS2 : Byte_String ABSOLUTE S2; *)
(* B : BOOLEAN; *)
(* I : INTEGER; *)
(* *)
(* BEGIN *)
(* *)
(* B := TRUE; *)
(* I := 1; *)
(* *)
(* WHILE( B AND ( I <= N ) ) DO *)
(* BEGIN *)
(* B := ( BS1[I] = BS2[I] ); *)
(* I := SUCC( I ); *)
(* END; *)
(* *)
(* Cmps := B; *)
(* *)
(* END; *)
(* *)
(*----------------------------------------------------------------------*)
BEGIN (* CmpS *)
INLINE(
$1E { PUSH DS ;Save DS}
/$C5/$B6/>S1 { LDS SI,[BP+>S1] ;Get first string address}
/$C4/$BE/>S2 { LES DI,[BP+>S2] ;Get second string address}
/$8B/$8E/>N { MOV CX,[BP+>N] ;Get # characters to compare}
/$FC { CLD ;Forward direction}
/$F3/$A6 { REPE CMPSB ;Compare strings}
/$74/$05 { JE Matched ;Skip if matched}
/$31/$C0 { XOR AX,AX ;Flag indicates no match}
/$E9/$03/$00 { JMP Return}
/$B8/$01/$00 {Matched: MOV AX,1 ;Flag indicates match}
/$1F {Return: POP DS ;Restore DS}
/$09/$C0 { OR AX,AX}
/$89/$EC { MOV SP,BP}
/$5D { POP BP}
/$C2/$0B/$00 { RET 11}
);
END (* CmpS *);
(*----------------------------------------------------------------------*)
BEGIN (* Do_Script_Checks *)
(* Skip checks for NUL, DEL *)
IF ( ( Ch = CHR( NUL ) ) OR ( Ch = CHR( DEL ) ) ) THEN
EXIT;
(* Check for WHEN string *)
IF When_Mode THEN
BEGIN
L := ORD(Script_When_Save[0]);
IF L < ORD( Script_When_Text[0] ) THEN
BEGIN
L := SUCC( L );
Script_When_Save[L] := Ch;
Script_When_Save[0] := CHR( L );
END
ELSE
BEGIN
MOVE( Script_When_Save[2], Script_When_Save[1], PRED( L ) );
Script_When_Save[L] := Ch;
IF ( Script_When_Text[1] = Script_When_Save[1] ) THEN
IF ( CmpS( Script_When_Text[1] , Script_When_Save[1] , L ) ) THEN
BEGIN
Script_When_Save[0] := #0;
Send_Function_Key( Read_Ctrls( Script_When_Reply_Text ) );
END;
END;
END (* When_Mode *);
(* Check for WAITCOUNT *)
IF WaitCount_Mode THEN
BEGIN
Script_Wait_Char_Count := SUCC( Script_Wait_Char_Count );
IF ( Script_Wait_Char_Count >= Script_Wait_Check_Length ) THEN
BEGIN
WaitCount_Mode := FALSE;
Really_Wait_String := FALSE;
Script_Wait_Found := TRUE;
END
ELSE IF ( TimeDiff( Script_Wait_Start , TimeOfDay ) > Script_Wait_Time ) THEN
BEGIN
WaitCount_Mode := FALSE;
Really_Wait_String := FALSE;
Script_Wait_Found := FALSE;
END;
END;
(* Check for WAITQUIET *)
IF WaitQuiet_Mode THEN
IF ( TimeDiffH( Script_Wait_Start , TimeOfDay ) >= Script_WaitQuiet_Time ) THEN
BEGIN
WaitQuiet_Mode := FALSE;
Really_Wait_String := FALSE;
END;
(* Check for WAIT string *)
IF WaitString_Mode THEN
BEGIN
(* Add in new character and *)
(* check if wait string(s) present *)
L := ORD( Script_Wait_Save[0] );
IF ( L < Script_Wait_Check_Length ) THEN
BEGIN
Script_Wait_Save[L+1] := Ch;
Script_Wait_Save[0] := CHR( SUCC( L ) );
END
ELSE
BEGIN
MOVE( Script_Wait_Save[2], Script_Wait_Save[1], PRED( L ) );
Script_Wait_Save[L] := Ch;
END;
FOR I := 1 TO Script_Wait_Count DO
WITH Script_Wait_List[I] DO
BEGIN
L2 := ORD(Wait_Text^[0]);
IF( L >= L2 ) THEN
IF ( Wait_Text^[1] = Script_Wait_Save[L - L2 + 1] ) THEN
IF ( CmpS( Wait_Text^[1] ,
Script_Wait_Save[L - L2 + 1], L2 ) ) THEN
BEGIN
Script_Wait_Save[0] := #0;
Script_Wait_Found := TRUE;
WaitString_Mode := FALSE;
Really_Wait_String := FALSE;
IF ( Script_Wait_Result_Index > 0 ) THEN
Script_Variables^[Script_Wait_Result_Index].Var_Value^ :=
CHR( I ) + CHR( 0 );
Send_Function_Key( Read_Ctrls( Wait_Reply^ ) );
GOTO 1;
END;
END;
(* Check if wait time exhausted *)
1: IF WaitString_Mode THEN
Check_Wait_String_Time
ELSE (* Free up waitstring storage *)
BEGIN
FOR I := 1 TO Script_Wait_Count DO
WITH Script_Wait_List[I] DO
BEGIN
DISPOSE( Wait_Text );
DISPOSE( Wait_Reply );
END;
Script_Wait_Count := 0;
END;
END (* WaitString_Mode *);
(* Check for Script LEARN mode *)
IF Script_Learn_Mode THEN
BEGIN
L := ORD( Script_String_2[0] );
IF ( L < Script_Learn_Buffer_Size ) THEN
BEGIN
L := SUCC( L );
Script_String_2[L] := Ch;
Script_String_2[0] := CHR( L );
END
ELSE
BEGIN
MOVE( Script_String_2[2], Script_String_2[1],
PRED( Script_Learn_Buffer_Size ) );
Script_String_2[Script_Learn_Buffer_Size] := Ch;
END;
END (* Script_Learn_Mode *);
END (* Do_Script_Checks *);